COVID Momentum

Data up to date as of 2020-11-23 17:09:52. From covidtracking.com

The USA is experiencing a large spike in COVID cases. But do we know anything else about our trajectory? Is the rate of growth accelerating or decelerating? Are we near the peak of the “third spike”? Basic calculus can give us the answers.

df <-
  GET("https://api.covidtracking.com/v1/us/daily.json") %>%
  content(as = "text", encoding = "UTF-8") %>%
  fromJSON(flatten=TRUE)

# reactable(df, height=400)

df <- df %>%
  arrange(date) %>%
  mutate(n = 1:n()) %>%
  select(n, new = positiveIncrease)

First let’s check out the numbers. Here we fit a loess curve to the data, and can see pretty clearly that we are in the midst of a third distinct peak in daily new cases.

ggplotly(
  ggplot(df, aes(x = n, y = new)) +
  geom_point() +
  geom_smooth(method = "loess", formula = y~x, span = 0.2)
)

What is the rate of change in new COVID cases? Well, a synonym for “rate of change” is “first derivative.” And what’s happening with the growth rate, is it increasing or decreasing? The “second derivative” will tell us.

curve <- 
  loess(new ~ n, df, span = 0.2) %>%
  predict(x=df$new) %>%
  as.data.frame() %>%
  rowid_to_column("n") %>%
  rename(fitted_value=".")

lag_change <- function(x) {
  ifelse(!is.na(lag(x)), x-lag(x), NA)
}

lag_sign <- function(x) {
  ifelse(!is.na(lag(x)), sign(x) != sign(lag(x)), NA)
}

df <- curve %>%
  mutate(
    dY = lag_change(fitted_value),
    d2Y = lag_change(dY),
    turning_point = lag_sign(dY),
    inflection = lag_sign(d2Y)
  ) %>%
  melt(id.vars=c("n", "inflection", "turning_point"))

df_d1 <- subset(df, variable != "d2Y")
df_d2 <- subset(df, variable != "dY")

Here we compare the fit curve of COVID cases with its first derivative. Whenever the first derivative (bottom chart) flips from positive to negative (or vice versa), we see a local maxima or minima. These can be thought of as “turning points.” For instance, on Day 88 of the pandemic (April 18th), we see the peak of the first spike (purple dot). Hover over the chart to see more info.

ggplotly(
  ggplot(df_d1, aes(x=n, y=value, color=variable)) +
  geom_line() +
  geom_point(
    data = subset(df_d1, turning_point == TRUE),
    color = "purple"
  ) +
  facet_wrap(vars(variable), ncol=1, scales="free")
)

Now we look at the second derivative. This shows us when the rate of change (first derivative) flips between positive and negative. These are known as “inflection points,” or “elbows in the curve,” where a curve first begins to lose or pick up steam. You can see that inflection points tend to pop up either before or after a turning point.

If there was an inflection point today, this would be a sign that the rate of growth in COVID cases is slowing down. Unfortunately, as of this writing, this is not the case. COVID cases are still in the midst of their third spike, with no immediate end in sight. Right now is probably analogous to around Day 166, or around 2/3 through the second spike.

ggplotly(
  ggplot(df_d2, aes(x=n, y=value, color=variable)) +
  geom_line() +
  geom_point(
    data = subset(df_d2, inflection == TRUE),
    color = "purple"
  ) +
  facet_wrap(vars(variable), ncol=1, scales="free")
)

Well, the bad news is that COVID isn’t really slowing down at the moment. But the good news is that we just used calculus for something actually meaningful in the real world!